The initial sample consisted of 409 participants (Mean age = 35.7, SD = 12.4, range: [18, 80]; Sex: 18.3% females, 80.4% males, 1.2% other; Education: Bachelor, 38.88%; Doctorate, 7.33%; High School, 23.47%; Master, 28.12%; Other, 1.47%; Primary School, 0.73%; Country: 28.61% USA, 13.45% France, 13.20% UK, 44.74% other).
Compute Scores
# Create Sexual "relevance" variable (Relevant, irrelevant, non-erotic)dftask <- dftask |>mutate(Relevance =case_when( Type =="Non-erotic"~"Non-erotic", Sex =="Male"& SexualOrientation =="Heterosexual"& Category =="Female"~"Relevant", Sex =="Female"& SexualOrientation =="Heterosexual"& Category =="Male"~"Relevant", Sex =="Male"& SexualOrientation =="Homosexual"& Category =="Male"~"Relevant", Sex =="Female"& SexualOrientation =="Homosexual"& Category =="Female"~"Relevant",# TODO: what to do with "Other"? SexualOrientation %in%c("Bisexual", "Other") & Category %in%c("Male", "Female") ~"Relevant",.default ="Irrelevant" ))
Recruitment History
Code
# Consecutive count of participants per day (as area)df |>mutate(Date =as.Date(Date, format ="%d/%m/%Y")) |>group_by(Date, Language, Experimenter) |>summarize(N =n()) |>ungroup() |># https://bocoup.com/blog/padding-time-series-with-rcomplete(Date, Language, Experimenter, fill =list(N =0)) |>group_by(Language, Experimenter) |>mutate(N =cumsum(N)) |>ggplot(aes(x = Date, y = N)) +geom_area(aes(fill=Experimenter)) +scale_y_continuous(expand =c(0, 0)) +labs(title ="Recruitment History",x ="Date",y ="Total Number of Participants" ) +facet_wrap(~Language, nrow=3) + see::theme_modern()
Code
# Tablesummarize(df, N =n(), .by=c("Language", "Experimenter")) |>arrange(desc(N)) |> gt::gt() |> gt::opt_stylize() |> gt::opt_interactive(use_compact_mode =TRUE) |> gt::tab_header("Number of participants per recruitment source")
Number of participants per recruitment source
Feedback
Evaluation
The majority of participants found it to be a “fun” experience. It is interesting to note that reports of “fun” were significantly associated with finding (some) stimuli arousing. Conversely, reporting “no feelings” was associated with finding the experiment “boring”.
For i = 2 j = 1 A cell entry of 0 was replaced with correct = 0.5. Check your data!
For i = 2 j = 1 A cell entry of 0 was replaced with correct = 0.5. Check your data!
The final sample includes 203 participants (Mean age = 37.9, SD = 13.4, range: [18, 80]; Sex: 15.8% females, 84.2% males, 0.0% other; Education: Bachelor, 34.98%; Doctorate, 8.87%; High School, 19.21%; Master, 34.98%; Other, 1.48%; Primary School, 0.49%; Country: 27.09% USA, 16.26% France, 11.82% UK, 44.83% other).
Code
p_country <- dplyr::select(df, region = Country) |>group_by(region) |>summarize(n =n()) |>right_join(map_data("world"), by ="region") |>ggplot(aes(long, lat, group = group)) +geom_polygon(aes(fill = n)) +scale_fill_gradientn(colors =c("#FFEB3B", "red", "purple")) +labs(fill ="N") +theme_void() +labs(title ="A Geographically Diverse Sample", subtitle ="Number of participants by country") +theme(plot.title =element_text(size =rel(1.2), face ="bold", hjust =0),plot.subtitle =element_text(size =rel(1.2)) )p_country
Code
ggwaffle::waffle_iron(df, ggwaffle::aes_d(group = Ethnicity), rows=10) |>ggplot(aes(x, y, fill = group)) + ggwaffle::geom_waffle() +coord_equal() +scale_fill_flat_d() + ggwaffle::theme_waffle() +labs(title ="Self-reported Ethnicity", subtitle ="Each square represents a participant", fill="") +theme(plot.title =element_text(size =rel(1.2), face ="bold", hjust =0),plot.subtitle =element_text(size =rel(1.2)),axis.title.x =element_blank(),axis.title.y =element_blank() )
Warning: Using the `size` aesthetic in this geom was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` in the `default_aes` field and elsewhere instead.
Code
p_age <-estimate_density(df$Age) |>normalize(select = y) |>mutate(y = y *86) |># To match the binwidthggplot(aes(x = x)) +geom_histogram(data=df, aes(x = Age), fill ="#616161", bins=28) +# geom_line(aes(y = y), color = "orange", linewidth=2) +geom_vline(xintercept =mean(df$Age), color ="red", linewidth=1.5) +# geom_label(data = data.frame(x = mean(df$Age) * 1.15, y = 0.95 * 75), aes(y = y), color = "red", label = paste0("Mean = ", format_value(mean(df$Age)))) +scale_x_continuous(expand =c(0, 0)) +scale_y_continuous(expand =c(0, 0)) +labs(title ="Age", y ="Number of Participants", color =NULL, subtitle ="Distribution of participants' age") +theme_modern(axis.title.space =10) +theme(plot.title =element_text(size =rel(1.2), face ="bold", hjust =0),plot.subtitle =element_text(size =rel(1.2), vjust =7),axis.text.y =element_text(size =rel(1.1)),axis.text.x =element_text(size =rel(1.1)),axis.title.x =element_blank() )p_age
We computed two type of general scores for the BAIT scale, an empirical score based on the average of observed data (of the most loading items) and a model-based score as predicted by the structural model. The first one gives equal weight to all items (and keeps the same [0-1] range), while the second one is based on the factor loadings and the covariance structure.
While the two correlate substantially, they have different benefits. The empirical score has a more straightforward meaning and is more reproducible (as it is not based on a model fitted on a specific sample), the model-based score takes into account the relative importance of the contribution of each item to their factor.
Comments
Code